home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / TECHNICA / AUTOCAD / H107.ZIP / APR91.ZIP / BOLT.LSP < prev    next >
Text File  |  1991-05-13  |  7KB  |  205 lines
  1. ; BOLT.LSP   [Article Figure 5]   (c)1991, Barry Bowen
  2.  
  3. ;**************************************************************
  4. ; BOLT.LSP
  5. ; Bolt program
  6. ; Copyright (c) Barry R. Bowen
  7. ; --------------------- GETSIZE -------------------------------
  8. ; Get Bolt or Nut Size
  9. (defun GETSIZE ()
  10.   (initget 1 "B N")
  11.   (setq HEX (getkword "\n<B>olt or <N>ut: "))
  12.   (if (= HEX "B")
  13.    (progn
  14.      (prompt "\n1/4  5/16   3/8   7/16   1/2  5/8   3/4  7/8")
  15.      (prompt "\n1.0  1.125  1.25  1.375  1.5  1.75  2.0  2.25")
  16.      (setq SIZE (getstring "\nNominal Size of Hex Bolt: "))
  17.      (BEGIN "HBOLT.DAT")
  18.    )
  19.    (progn
  20.      (prompt
  21.          "\n1/4  5/16   3/8   7/16   1/2  9/16  5/8  3/4  7/8")
  22.      (prompt "\n1.0  1.125  1.25  1.375  1.5")
  23.      (setq SIZE (getstring "\nNominal Size of Hex Nut: "))
  24.      (BEGIN "HNUT.DAT")
  25.   ))
  26. )
  27. ; ----------------------- BEGIN -------------------------------
  28. ; Start-up routine
  29. (defun BEGIN (DATA)
  30.   (if (not MPT) (setq MPT (getpoint "\nInsertion Point: ")))
  31.   (setq CK nil EN (entlast)
  32.       FILE (open DATA "r")
  33.         SL (strlen SIZE)
  34.       LINE (read-line FILE))
  35.   (while (and LINE (/= SIZE (substr LINE 1 SL)))
  36.     (setq LINE (read-line FILE)))
  37.   (close FILE)
  38.   (if (not (member LINE '(nil "")))
  39.     (if (= SIZE (substr LINE 1 SL))
  40.      (progn (GETDAT) (setq CK T)))
  41.     (prompt "\nRequested Size Not found!")
  42.   ) (princ)
  43. )
  44. ; ----------------------- GETDAT ------------------------------
  45. ; Get Data from required file
  46. (defun GETDAT ()
  47.    (setq BN (substr LINE 11 10))
  48.    (STRBN)
  49.    (setq S1 (atof (substr LINE 21 10))
  50.          S2 (atof (substr LINE 31 10))
  51.          S3 (atof (substr LINE 41 10))
  52.          S4 (atof (substr LINE 51 10))
  53.          S5 (atof (substr LINE 61 10)))
  54. )
  55. ; ----------------------- STRBN -------------------------------
  56. ; Get block name
  57. (defun STRBN ()
  58.   (setq LGTH 1 TSTR (strlen BN)
  59.           CH (substr BN LGTH 1))
  60.   (while (and (/= CH " ") (/= CH ""))
  61.      (setq LGTH (1+ LGTH) CH (substr BN LGTH 1)))
  62.   (setq BN (substr BN 1 (1- LGTH)))
  63.   (if (= VIEW "EL") (setq BN (strcat VIEW BN)))
  64. )
  65. ; ----------------------- HBOLTP ------------------------------
  66. ; Hex Bolt or Hex Nut drawn in Plan view
  67. (defun C:HBOLTP (/ CK SS1)
  68.   (V3)
  69.   (GETSIZE)
  70.   (if (= CK T) (progn
  71.     (if (= (tblsearch "block" BN) nil)
  72.       (progn
  73.            (command "insert" "HBOLTP" MPT S2 S2 0
  74.                     "block" BN MPT (entlast) ""
  75.                     "insert" BN MPT 1 1 0)
  76.       ) ;End Progn
  77.       (command "insert" BN MPT 1 1 0)
  78.   ) ) )
  79.   (setq ANS (getstring "\nAdd Washer <Y>? "))
  80.   (if (or (= ANS "") (= ANS "Y") (= ANS "y")) (WASHP))
  81.   (setq MPT nil)
  82.   (V4)
  83. )
  84. ; ----------------------- HBOLTE ------------------------------
  85. ; Hex Bolt drawn in Elevation view
  86. (defun C:HBOLTE (/ CK SS1 HEX SIZE)
  87.   (V3)
  88.   (setq VIEW "EL")
  89.   (GETSIZE)
  90.   (if (= CK T) (progn
  91.     (setq ANG (getangle "\nRotation Angle: ")
  92.           ANG (angtos ANG))
  93.     (if (= (tblsearch "block" BN) nil)
  94.       (progn
  95.         (setq G1 (/ S2 2.0)
  96.               G2 (/ S2 4.0)
  97.               G3 (/ S2 8.0)
  98.               PT1 (polar MPT pi G1)
  99.               PT2 (polar PT1 0 S2)
  100.               PT3 (polar (polar PT1 0 G3) (D90) S3)
  101.               PT4 (polar (polar PT2 pi G3) (D90) S3)
  102.               PT1A (polar PT1 (D90) 1.0)
  103.               PT3A (polar PT3 3.66519 1.0)
  104.               PT5 (inters PT1 PT1A PT3 PT3A nil)
  105.               PT6 (polar PT1 0 G2)
  106.               DIST (distance PT1 PT5)
  107.               DIFF (- S3 DIST)
  108.               PT7 (polar PT6 (D90) DIST)
  109.               PT8 (polar PT2 pi G2)
  110.               PT9 (polar PT8 (D90) DIST)
  111.               PT10 (polar PT2 (D90) DIST)
  112.               PT11 (polar PT1 (D90) DIFF)
  113.              PT11A (polar PT1 0 G3)
  114.               PT12 (polar PT6 (D90) DIFF)
  115.               PT13 (polar PT8 (D90) DIFF)
  116.              PT13A (polar PT8 0 G3)
  117.               PT14 (polar PT2 (D90) DIFF)
  118.               MPT1 (polar MPT (D90) S3)
  119.         )
  120.         (setq EN (entlast))
  121.         (command "pline" PT10 "a" "s" PT4 PT9 "s" MPT1 PT7
  122.                  "s" PT3 PT5 ""
  123.                  "line" PT3 PT4 "")
  124.         (if (= HEX "B") (progn
  125.           (command "line" PT5 PT1  PT2 PT10 ""
  126.                    "line" PT6 PT7 ""
  127.                    "line" PT8 PT9 ""))
  128.           (progn
  129.             (command "pline" PT11 "a" "s" PT11A PT12
  130.                      "s" MPT PT13 "s" PT13A PT14 ""
  131.                      "line" PT11A PT13A ""
  132.                      "line" PT11 PT5 ""
  133.                      "line" PT12 PT7 ""
  134.                      "line" PT13 PT9 ""
  135.                      "line" PT14 PT10 "")
  136.         ) )
  137.         (MKSET)
  138.         (command "block" BN MPT SS1 "")
  139.         (command "insert" BN MPT 1 1 ANG)
  140.       )
  141.       (command "insert" BN MPT 1 1 ANG)
  142.   ) ) )
  143.   (setq ANS (getstring "\nAdd Washer <Y>? "))
  144.   (if (or (= ANS "") (= ANS "Y") (= ANS "y")) (WASHE))
  145.   (setq MPT nil VIEW nil)
  146.   (V4)
  147. )
  148. ; ------------------------ WASHE ------------------------------
  149. ; Washer drawn in Elevation View
  150. (defun WASHE (/ CK SS1)
  151.   (V3)
  152.   (setq VIEW "EL")
  153.   (BEGIN "AWASHER.DAT")
  154.   (if (= CK T) (progn
  155.     (if (= (tblsearch "block" BN) nil)
  156.       (progn
  157.         (command "insert" "WASHEL" MPT S1 S2 0
  158.                  "block" BN MPT (entlast) ""
  159.                  "insert" BN MPT 1 1 ANG)
  160.       ) (command "insert" BN MPT 1 1 ANG)
  161.   ) ) )
  162.   (setq MPT nil VIEW nil)
  163.   (V4)
  164. )
  165. ; ------------------------ WASHP ------------------------------
  166. ; Washer drawn in Plan View
  167. (defun WASHP (/ CK SS1)
  168.   (V3)
  169.   (BEGIN "AWASHER.DAT")
  170.   (if (= CK T) (progn
  171.     (if (= (tblsearch "block" BN) nil)
  172.       (progn
  173.         (command "circle" MPT "d" S1
  174.                  "block" BN MPT (entlast) ""
  175.                  "insert" BN MPT 1 1 0)
  176.       ) (command "insert" BN MPT 1 1 0)
  177.   ) ) ) (V4)
  178. )
  179. ; ------------------------ MKSET ------------------------------
  180. ; Make a selection-set of all entities
  181. (defun MKSET ()
  182.     (setq SS1 (ssadd) EN1 (entnext EN))
  183.      (while EN
  184.         (setq SS1 (ssadd EN1 SS1)
  185.               EN1 (entnext EN)
  186.               EN EN1))
  187. )
  188. (defun D90 () (* pi 0.5))
  189. ; ------------------------ V3.LSP -----------------------------
  190. (defun V3 ()
  191.   (setq BM (getvar "blipmode")) ;Current Blipmode setting
  192.   (setvar "blipmode" 0)         ;Turn Blips off
  193.   (setvar "cmdecho" 0)          ;Turn command echo off
  194.   (command "undo" "group")      ;Necessary for correct UNDO
  195.                                 ;of program being executed
  196. )
  197. ; ------------------------ V4.LSP -----------------------------
  198. (defun V4 (/ BA)
  199.   (setvar "blipmode" BM)   ;Reset to original setting
  200.   (command "undo" "end")   ;End of UNDO sequence
  201.   (prompt "\n")            ;New line
  202.   (setq BA "Program Completed. . . . .") ;Prints string
  203. )
  204. 
  205.